home *** CD-ROM | disk | FTP | other *** search
/ Mega Guia 2004 June / Mega Guia: 2004-06.iso / _files / free / myalbum / ES / myalbumsetup.exe / {app} / MergeAlbums.vbs < prev    next >
Text File  |  2002-11-28  |  4KB  |  138 lines
  1. ' ------------------------------------------------------------------------------------
  2. '                MergeAlbums.vbs
  3. ' Merges two albums
  4. ' All the selected pictures from one album are copied to the second.
  5. ' Picture comment, keywords and custom fields are preserved.
  6. ' PMe-020105 : Update for copying of the 2.0 fields
  7. ' ------------------------------------------------------------------------------------
  8.  
  9. Option Explicit
  10.  
  11. 'const CF_STRING=0
  12. 'const CF_DATE=1
  13. 'const CF_TIME=2
  14.  
  15. Function DoMerge
  16. dim albSrc, albDst
  17. set albSrc = app.GetAlbum(1)
  18. set albDst = app.GetAlbum(0)
  19.  
  20. dim s, k
  21. s = "This script will append the selected pictures from one album to another." & chr(13) & chr(13)
  22. s = s & "First album: " & albSrc.sAlbumTitle & " (" & albSrc.FullName & ")" & chr(13)
  23. s = s & "Second album:" & albDst.sAlbumTitle &  " (" & albDst.FullName & ")" & chr(13) & chr(13)
  24. s = s & "Click Yes to copy 1 --> 2" & chr(13)
  25. s = s & "Click No  to copy 2 --> 1" & chr(13) & chr(13)
  26. s = s & "Click Cancel to abort"
  27. k = MsgBox( s, vbYesNoCancel, "MyAlbum Merger" )
  28.  
  29. if k = vbYes or k = vbNo  then
  30.  
  31.   if k = vbNo then
  32.     dim a
  33.     set a = albSrc
  34.     set albSrc = albDst
  35.     set albDst = a
  36.   end if
  37.  
  38.   dim i, j, kw, kw2
  39.  
  40.   ' Merge the keywords
  41.   dim nbKW, tabKW()
  42.   nbKW = albSrc.nbKeyword
  43.   redim tabKW(nbKW)
  44.   app.Trace "Source album has " & nbKW & " keywords"
  45.   for i = 0 to nbKW-1
  46.     set kw = albSrc.getKeyword(i)
  47.     tabKW(i) = kw.sName
  48.     set kw2 = albDst.addKeyword( tabKW(i) )
  49.     app.Trace chr(9) & tabKW(i)
  50.     if kw.bIsTab then kw2.bIsTab = True
  51.   next
  52.  
  53.   ' Merge the custom fields
  54.   dim nbCF, tabCF(), tabCFType()
  55.   nbCF = albSrc.nbCustomField
  56.   redim tabCF(nbCF), tabCFType(nbCF)
  57.   app.Trace "Source album has " & nbCF & " custom fields"
  58.   for i = 0 to nbCF-1
  59.     set kw = albSrc.getCustomField(i)
  60.     tabCF(i) = kw.sName
  61.     tabCFType(i) = kw.nType
  62.     s = chr(9) & tabCF(i) & " is "
  63.     select case tabCFType(i)
  64.       case CF_STRING
  65.         s = s & "String"
  66.       case CF_DATE
  67.         s = s & "Date"
  68.       case CF_TIME
  69.         s = s & "Time"
  70.     end select
  71.     app.Trace s
  72.     set kw2 = albDst.addCustomField( tabCF(i), tabCFType(i) )
  73.   next
  74.  
  75.   ' Process each picture
  76.   Dim nbPic
  77.   nbPic = albSrc.nbPicture
  78.   app.Trace "Pictures to copy to second album: " & nbPic
  79.  
  80.   dim pic, pic2, filename
  81.   for i = 0 to nbPic-1
  82.     Set pic = albSrc.GetPicture(i)
  83.     if pic.bSelected then    ' Process only the selected pictures
  84.  
  85.       ' Get the relative path of the picture
  86.       filename = albSrc.ExpandMacro( pic, "%RP" )
  87.       app.Trace "Processing picture #" & i+1 & " " & filename
  88.  
  89.       Set pic2 = albDst.AddPicture( filename )
  90.       ' Copy picture information
  91.       pic2.sComment = pic.sComment
  92.       pic2.sURL = pic.sURL
  93.       pic2.sPlayCmd = pic.sPlayCmd
  94.  
  95.       ' Copy the new fields of the 2.0 version
  96.       pic2.lDisplayMode = pic.lDisplayMode
  97.       pic2.lTransition = pic.lTransition
  98.       pic2.rcCrop = pic.rcCrop
  99.       pic2.nRotation = pic.nRotation
  100.  
  101.       ' Copy the keyword info
  102.       for j = 0 to nbKW-1
  103.         set kw = albSrc.getKeyword(j)
  104.         if pic.HasKeyword( kw.sName ) then pic2.SetKeyword kw.sName, True
  105.       next
  106.  
  107.       ' Copy the custom field info
  108.       for j = 0 to nbCF-1
  109.         set kw = albSrc.getCustomField(j)
  110.         if kw.nType <> CF_STRING then
  111.           k = pic.GetCustomFieldDate( kw.sName )
  112.           if k <> 0 then pic2.SetCustomFieldDate kw.sName, k
  113.         else
  114.           s = pic.GetCustomField( kw.sName )
  115.           if len(s) > 0 then pic2.SetCustomField kw.sName, s
  116.         end if
  117.       next
  118.     end if
  119.   next
  120.  
  121.   albDst.Redraw
  122.   app.Trace "Done !"
  123.  
  124. end if
  125. End Function
  126.  
  127.  
  128. ' Main program
  129. app.ClearTrace
  130.  
  131. dim nb
  132. nb = app.nbAlbum
  133. if nb < 2 then
  134.   MsgBox "Two albums should be open for the merge operation", 0, "MyAlbum Merger"
  135. else
  136.   DoMerge
  137. end if
  138.